randomly choose more than 5 elements of corr matrix for cell type 1. v
print out the covariance matrix of each cell type with 2 decimal points (round). v
figure out how to merge this current version and the previous version. v?
# to update the element(s) of correlation matrix, other than the diagonal elems
covmat_change <- function(matrix, pair_lst, scale){
diag_elem <- diag(matrix)
for (i in 1:nrow(pair_lst)){
elem <- pair_lst[i,]
ind1 <- elem[1]; ind2 <- elem[2];
a <- diag_elem[ind1]; d <- diag_elem[ind2];
# half of sqrt(ad)
new_val <- sqrt(a * d) / scale
matrix[ind1, ind2] <- new_val; matrix[ind2, ind1] <- new_val;
}
return (matrix)
}
# set the dimension
p <- 10
first_n <- 500
copula_mean_first <- c(0, 0, 0, 0, 0,
0, 0, 0, 0, 0) # mu
cov_mat_first <- matrix(0, p, p);
diag(cov_mat_first) <- c(0.9, 10, 1, 9, 7,
1.1, 5, 0.9, 1, 5)
set.seed(29)
rep_num <- 2
# randomly choose 5 elements of corr matrix to manually change the value
random_pair_first <- replicate(rep_num,
matrix(sample(1:p), ncol = 2),
simplify = "vector")
cov_mat_first <- covmat_change(cov_mat_first, random_pair_first, 2)
# Covariance Matrix of first cell type
round(cov_mat_first, 2)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,] 0.90 0.00 0.00 1.42 1.25 0.00 0.00 0.00 0.00 0.00
## [2,] 0.00 10.00 1.58 0.00 0.00 0.00 0.00 0.00 0.00 3.54
## [3,] 0.00 1.58 1.00 0.00 0.00 0.00 0.00 0.00 0.50 0.00
## [4,] 1.42 0.00 0.00 9.00 3.97 0.00 0.00 0.00 0.00 0.00
## [5,] 1.25 0.00 0.00 3.97 7.00 0.00 0.00 0.00 0.00 0.00
## [6,] 0.00 0.00 0.00 0.00 0.00 1.10 1.17 0.00 0.00 1.17
## [7,] 0.00 0.00 0.00 0.00 0.00 1.17 5.00 1.06 0.00 0.00
## [8,] 0.00 0.00 0.00 0.00 0.00 0.00 1.06 0.90 0.47 0.00
## [9,] 0.00 0.00 0.50 0.00 0.00 0.00 0.00 0.47 1.00 0.00
## [10,] 0.00 3.54 0.00 0.00 0.00 1.17 0.00 0.00 0.00 5.00
set.seed(32)
norm_first <- MASS::mvrnorm(first_n, copula_mean_first, cov_mat_first)
copula_first <- norm_first
# nonparanormal transform
copula_first <- apply(copula_first, 2, function(x) {0.4 * sign(x) * abs(x)^1.2})
# Add (0,0) mark
norm_first <- rbind(norm_first, rep(0, 10))
copula_first <- rbind(copula_first, rep(0, 10))
# this is the gaussian data we need to make nonparanormals
pairs(norm_first, asp = T, pch = 16, lower.panel = NULL,
col = c(rep(rgb(0.5,0.5,0.5,0.5), nrow(norm_first)-1), rgb(1,0,0,0.5)))
# this is the nonparanormal
pairs(copula_first, asp = T, pch = 16, lower.panel = NULL,
col = c(rep(rgb(0.5,0.5,0.5,0.5), nrow(copula_first)-1), rgb(1,0,0,0.5)))
# get upper matrix indices
get_upper_ind <- function(n){
c <- NULL
for (i in 1:(n-1)){
a <- rep(i, (n - i))
b <- ((i+1):n)
if (is.null(c)){
c <- cbind(a,b)
if (n == 1){
return (c)
}
} else {
c <- rbind(c, cbind(a,b))
}
}
return (c)
}
second_n <- 20
copula_mean_second <- c(7, 7, 8, 6, 6,
7, 6, 7, 9, 7)
cov_mat_second <- matrix(0, p, p);
set.seed(181)
# higher variance up to 10
diag(cov_mat_second) <- sample(16:25, 10, replace = TRUE,
prob = c(1, 1, 1, 1, 31,
1, 1, 1, 1, 1))# Sigma
upper_pair_second <- get_upper_ind(p)
cov_mat_second <- covmat_change(cov_mat_second, upper_pair_second, 1.5)
round(cov_mat_second, 2)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,] 20.00 13.98 13.33 13.33 13.33 13.33 12.29 13.33 12.65 13.33
## [2,] 13.98 22.00 13.98 13.98 13.98 13.98 12.89 13.98 13.27 13.98
## [3,] 13.33 13.98 20.00 13.33 13.33 13.33 12.29 13.33 12.65 13.33
## [4,] 13.33 13.98 13.33 20.00 13.33 13.33 12.29 13.33 12.65 13.33
## [5,] 13.33 13.98 13.33 13.33 20.00 13.33 12.29 13.33 12.65 13.33
## [6,] 13.33 13.98 13.33 13.33 13.33 20.00 12.29 13.33 12.65 13.33
## [7,] 12.29 12.89 12.29 12.29 12.29 12.29 17.00 12.29 11.66 12.29
## [8,] 13.33 13.98 13.33 13.33 13.33 13.33 12.29 20.00 12.65 13.33
## [9,] 12.65 13.27 12.65 12.65 12.65 12.65 11.66 12.65 18.00 12.65
## [10,] 13.33 13.98 13.33 13.33 13.33 13.33 12.29 13.33 12.65 20.00
norm_second <- MASS::mvrnorm(second_n, copula_mean_second, cov_mat_second)
copula_second <- norm_second
# nonparanormal transform
copula_second <- apply(copula_second, 2, function(x) {0.6 * sign(x) * abs(x)^1.2})
# Add (0,0) mark
norm_second <- rbind(norm_second, rep(0, 10))
copula_second <- rbind(copula_second, rep(0, 10))
# this is the gaussian data we need to make nonparanormals
pairs(norm_second, asp = T, pch = 16, lower.panel = NULL,
col = c(rep(rgb(0.5,0.5,0.5,0.5), nrow(norm_second)-1), rgb(1,0,0,0.5)))
# this is the nonparanormal
pairs(copula_second, asp = T, pch = 16, lower.panel = NULL,
col = c(rep(rgb(0.5,0.5,0.5,0.5), nrow(copula_second)-1), rgb(1,0,0,0.5)))
third_n <- 20
copula_mean_third <- c(6, 2, 3, 5, 5,
5, 5, 3, 5, 4)
cov_mat_third <- matrix(0, p, p);
# higher variance up to 10
diag(cov_mat_third) <- sample(c(1,2,4, 10,25,26), 10, replace = TRUE)
set.seed(32)
upper_pair_third <- get_upper_ind(p)
cov_mat_third <- covmat_change(cov_mat_third, upper_pair_third, 2)
round(cov_mat_third, 2)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,] 25.00 7.91 5.00 12.50 12.75 7.91 2.50 7.91 12.50 2.50
## [2,] 7.91 10.00 3.16 7.91 8.06 5.00 1.58 5.00 7.91 1.58
## [3,] 5.00 3.16 4.00 5.00 5.10 3.16 1.00 3.16 5.00 1.00
## [4,] 12.50 7.91 5.00 25.00 12.75 7.91 2.50 7.91 12.50 2.50
## [5,] 12.75 8.06 5.10 12.75 26.00 8.06 2.55 8.06 12.75 2.55
## [6,] 7.91 5.00 3.16 7.91 8.06 10.00 1.58 5.00 7.91 1.58
## [7,] 2.50 1.58 1.00 2.50 2.55 1.58 1.00 1.58 2.50 0.50
## [8,] 7.91 5.00 3.16 7.91 8.06 5.00 1.58 10.00 7.91 1.58
## [9,] 12.50 7.91 5.00 12.50 12.75 7.91 2.50 7.91 25.00 2.50
## [10,] 2.50 1.58 1.00 2.50 2.55 1.58 0.50 1.58 2.50 1.00
norm_third <- MASS::mvrnorm(third_n, copula_mean_third, cov_mat_third)
copula_third <- norm_third
# nonparanormal transform
copula_third <- apply(copula_third, 2, function(x) {0.6 * sign(x) * abs(x)^1.2})
# Add (0,0) mark
norm_third <- rbind(norm_third, rep(0, 10))
copula_third <- rbind(copula_third, rep(0, 10))
# this is the gaussian data we need to make nonparanormals
pairs(norm_third, asp = T, pch = 16, lower.panel = NULL,
col = c(rep(rgb(0.5,0.5,0.5,0.5), nrow(norm_third)-1), rgb(1,0,0,0.5)))
# this is the nonparanormal
pairs(copula_third, asp = T, pch = 16, lower.panel = NULL,
col = c(rep(rgb(0.5,0.5,0.5,0.5), nrow(copula_third)-1), rgb(1,0,0,0.5)))
full_dat <- rbind(cbind(copula_first, rep(1, first_n+1)),
cbind(copula_second, rep(2, second_n+1)),
cbind(copula_third, rep(3, third_n+1)))
gen_dat <- full_dat[, 1:10]
gen_label <- full_dat[, 11]
pairs(gen_dat, asp = T, pch = 16, col = gen_label, lower.panel = NULL)
pairs(gen_dat, asp = T, pch = 16, col = c(rep(rgb(0.5,0.5,0.5,0.5), nrow(gen_dat)-1), rgb(1,0,0,0.5)), lower.panel = NULL)
gen_dat <- gen_dat[1:(first_n + second_n + third_n), ]
gen_label <- gen_label[1:(first_n + second_n + third_n)]
library(reshape2) # melt function
library(ggplot2) # ggplot function
library(pcaPP) # Fast Kendall function
library(energy) # Distance Correlation
library(Hmisc) # Hoeffding's D measure
## Loading required package: lattice
## Loading required package: survival
## Loading required package: Formula
##
## Attaching package: 'Hmisc'
## The following objects are masked from 'package:base':
##
## format.pval, units
library(zebu) # Normalized Mutual Information
# library(minerva) # Maximum Information Coefficient
library(XICOR) # Chatterjee's Coefficient
# library(dHSIC) # Hilbert Schmidt Independence Criterion
library(VineCopula) # Blomqvist's Beta
make_cormat <- function(dat_mat){
dat_mat <- gen_dat
matrix_dat <- matrix(nrow = ncol(dat_mat), ncol = ncol(dat_mat))
cor_mat_list <- list()
basic_cor <- c("pearson", "spearman")
# find each of the correlation matrices with Pearson, Spearman, Kendall Correlation Coefficients
for (i in 1:2){
cor_mat <- stats::cor(dat_mat, method = basic_cor[i])
cor_mat[upper.tri(cor_mat, diag = T)] <- NA
cor_mat_list[[i]] <- cor_mat
}
# functions that take matrix or data.frame as input
no_loop_function <- c(pcaPP::cor.fk, Hmisc::hoeffd,
VineCopula::BetaMatrix)
for (i in 3:5){
fun <- no_loop_function[[i-2]]
cor_mat <- fun(dat_mat)
if (i == 4){ # Hoeffding's D
cor_mat <- cor_mat$D
}
cor_mat[upper.tri(cor_mat, diag = T)] <- NA
cor_mat_list[[i]] <- cor_mat
}
# functions that take two variables as input to calculate correlations.
need_loop <- c(zebu::lassie, energy::dcor2d, XICOR::calculateXI)
for (i in 6:8){
fun <- need_loop[[i-5]]
cor_mat <- matrix(nrow = ncol(dat_mat),
ncol = ncol(dat_mat))
for (j in 2:ncol(dat_mat)){
for (k in 1:(j-1)){
if (i == 6){
cor_mat[j, k] <- fun(cbind(dat_mat[, j], dat_mat[, k]), continuous=c(1,2), breaks = 6, measure = "npmi")$global
} else {
cor_mat[j, k] <- fun(as.numeric(dat_mat[, j]),
as.numeric(dat_mat[, k]))
}
}
}
cor_mat[upper.tri(cor_mat, diag = T)] <- NA
cor_mat_list[[i]] <- cor_mat
}
return(cor_mat_list)
}
draw_heatmap <- function(cor_mat){
len <- 8
melted_cormat <- melt(cor_mat)
melted_cormat <- melted_cormat[!is.na(melted_cormat$value),]
break_vec <- round(as.numeric(quantile(melted_cormat$value,
probs = seq(0, 1, length.out = len),
na.rm = T)),
4)
break_vec[1] <- break_vec[1]-1
break_vec[len] <- break_vec[len]+1
melted_cormat$value <- cut(melted_cormat$value, breaks = break_vec)
heatmap_color <- unique(melted_cormat$value)
heatmap <- ggplot(data = melted_cormat, aes(x = Var2, y = Var1, fill = value))+
geom_tile(colour = "Black") +
ggplot2::scale_fill_manual(breaks = sort(heatmap_color),
values = rev(scales::viridis_pal(begin = 0, end = 1)
(length(heatmap_color)))) +
theme_bw() + # make the background white
theme(panel.border = element_blank(), panel.grid.major = element_blank(),
panel.grid.minor = element_blank(), axis.ticks = element_blank(),
# erase tick marks and labels
axis.text.x = element_blank(), axis.text.y = element_blank())
return (heatmap)
}
make_cor_heatmap <- function(dat_mat){
fun_lable <- c("Pearson's Correlation", "Spearman's Correlation", "Kendall's Correlation",
"Hoeffding's D", "Blomqvist's Beta", "NMI",
"Distance Correlation", "XI Correlation")
cor_heatmap_list <- list()
cor_abs_heatmap_list <- list()
# make correlation matrices
cor_mat_list <- make_cormat(dat_mat)
for (i in 1:8){
cor_mat <- cor_mat_list[[i]]
# get heatmaps
cor_heatmap <- draw_heatmap(cor_mat)
# ggplot labels
ggplot_labs <- labs(title = paste("Heatmap of", fun_lable[i]),
x = "",
y = "",
fill = "Coefficient") # change the title and legend label
cor_heatmap_list[[i]] <- cor_heatmap + ggplot_labs
if (i %in% c(1,2,3,4,6)){
cor_abs_mat <- abs(cor_mat_list[[i]])
cor_abs_heatmap <- draw_heatmap(cor_abs_mat)
ggplot_abs_labs <- labs(title = paste("Abs Heatmap of", fun_lable[i]),
x = "", # change the title and legend label
y = "",
fill = "Coefficient")
cor_abs_heatmap_list[[i]] <- cor_abs_heatmap + ggplot_abs_labs
} else {
ggplot_abs_labs <- labs(title = paste("Abs Heatmap of", fun_lable[i]),
subtitle = "Equivalent to Non-Abs Heatmap",
x = "", # change the title and legend label
y = "",
fill = "Coefficient")
cor_abs_heatmap_list[[i]] <- cor_heatmap + ggplot_abs_labs
}
}
ans <- list(cor_heatmap_list, cor_abs_heatmap_list)
return (ans)
}
lst <- make_cor_heatmap(gen_dat)
cormat_list <- make_cormat(gen_dat)
# lst[[1]]
lst[[1]][[4]]
cor_pearson_mat <- cormat_list[[1]]; cor_spearman_mat <- cormat_list[[2]];
cor_kendall_mat <- cormat_list[[3]]; cor_hoeffd_mat <- cormat_list[[4]];
cor_blomqvist_mat <- cormat_list[[5]]; cor_dist_mat <- cormat_list[[6]];
cor_MI_mat <- cormat_list[[7]]; cor_XI_mat <- cormat_list[[8]];
cor_contrast1 <- (abs(cor_pearson_mat) < 0.5) & (abs(cor_spearman_mat) > 0.5)
cor_contrast_ind1 <- which(cor_contrast1, arr.ind = T)
nrow(cor_contrast_ind1)
## [1] 0
cor_contrast2 <- (abs(cor_pearson_mat) > 0.75) & (abs(cor_spearman_mat) < 0.2)
cor_contrast_ind2 <- which(cor_contrast2, arr.ind = T)
nrow(cor_contrast_ind2)
## [1] 10
par(mfrow = c(2, 5))
for (i in 1:nrow(cor_contrast_ind2)){
index1 <- cor_contrast_ind2[i, 1]; index2 <- cor_contrast_ind2[i, 2]
plot(gen_dat[,index1], gen_dat[,index2], col = gen_label, asp = T,
pch = 16, xlab = paste0(colnames(gen_dat)[index1], ", (", index1, ")"),
ylab = paste0(colnames(gen_dat)[index2], ", (", index2, ")"),
main = paste(paste0("Pearson of ", round(cor_pearson_mat[index1, index2], 3)),
"\n",
paste0("Spearman of ", round(cor_spearman_mat[index1, index2], 3))))
}
cor_contrast3 <- (abs(cor_pearson_mat) < 0.5) & (abs(cor_kendall_mat) > 0.5)
cor_contrast_ind3 <- which(cor_contrast3, arr.ind = T)
nrow(cor_contrast_ind3)
## [1] 0
cor_contrast4 <- (abs(cor_pearson_mat) > 0.75) & (abs(cor_kendall_mat) < 0.2)
cor_contrast_ind4 <- which(cor_contrast4, arr.ind = T)
nrow(cor_contrast_ind4)
## [1] 10
par(mfrow = c(2, 5))
for (i in 1:nrow(cor_contrast_ind4)){
index1 <- cor_contrast_ind4[i, 1]; index2 <- cor_contrast_ind4[i, 2]
plot(gen_dat[,index1], gen_dat[,index2], col = gen_label, asp = T,
pch = 16, xlab = paste0(colnames(gen_dat)[index1], ", (", index1, ")"),
ylab = paste0(colnames(gen_dat)[index2], ", (", index2, ")"),
main = paste(paste0("Pearson of ", round(cor_pearson_mat[index1, index2], 3)),
"\n",
paste0("Kendall of ", round(cor_kendall_mat[index1, index2], 3))))
}
cor_contrast5 <- (abs(cor_pearson_mat) < 0.5) & (abs(cor_hoeffd_mat) > 0.5)
cor_contrast_ind5 <- which(cor_contrast5, arr.ind = T)
nrow(cor_contrast_ind5)
## [1] 0
cor_contrast6 <- (abs(cor_pearson_mat) > 0.85) & (abs(cor_hoeffd_mat) < 0.2)
cor_contrast_ind6 <- which(cor_contrast6, arr.ind = T)
nrow(cor_contrast_ind6)
## [1] 7
par(mfrow = c(2, 3))
for (i in 1:nrow(cor_contrast_ind6)){
index1 <- cor_contrast_ind6[i, 1]; index2 <- cor_contrast_ind6[i, 2]
plot(gen_dat[,index1], gen_dat[,index2], col = gen_label, asp = T,
pch = 16, xlab = paste0(colnames(gen_dat)[index1], ", (", index1, ")"),
ylab = paste0(colnames(gen_dat)[index2], ", (", index2, ")"),
main = paste(paste0("Pearson of ", round(cor_pearson_mat[index1, index2], 3)),
"\n",
paste0("Hoeffding's D of ", round(cor_hoeffd_mat[index1, index2], 3))))
}
cor_contrast7 <- (abs(cor_pearson_mat) < 0.5) & (abs(cor_blomqvist_mat) > 0.5)
cor_contrast_ind7 <- which(cor_contrast7, arr.ind = T)
nrow(cor_contrast_ind7)
## [1] 0
cor_contrast8 <- (abs(cor_pearson_mat) > 0.7) & (abs(cor_blomqvist_mat) < 0.4)
cor_contrast_ind8 <- which(cor_contrast8, arr.ind = T)
nrow(cor_contrast_ind8)
## [1] 6
par(mfrow = c(2, 3))
for (i in 1:nrow(cor_contrast_ind8)){
index1 <- cor_contrast_ind8[i, 1]; index2 <- cor_contrast_ind8[i, 2]
plot(gen_dat[,index1], gen_dat[,index2], col = gen_label, asp = T,
pch = 16, xlab = paste0(colnames(gen_dat)[index1], ", (", index1, ")"),
ylab = paste0(colnames(gen_dat)[index2], ", (", index2, ")"),
main = paste(paste0("Pearson of ", round(cor_pearson_mat[index1, index2], 3)),
"\n",
paste0("Beta of ", round(cor_blomqvist_mat[index1, index2], 3))))
}
cor_contrast9 <- (abs(cor_pearson_mat) < 0.5) & (abs(cor_XI_mat) > 0.5)
cor_contrast_ind9 <- which(cor_contrast9, arr.ind = T)
nrow(cor_contrast_ind9)
## [1] 0
cor_contrast10 <- (abs(cor_pearson_mat) > 0.75) & (abs(cor_XI_mat) < 0.2)
cor_contrast_ind10 <- which(cor_contrast10, arr.ind = T)
nrow(cor_contrast_ind10)
## [1] 10
par(mfrow = c(2, 5))
for (i in 1:nrow(cor_contrast_ind10)){
index1 <- cor_contrast_ind10[i, 1]; index2 <- cor_contrast_ind10[i, 2]
plot(gen_dat[,index1], gen_dat[,index2], col = gen_label, asp = T,
pch = 16, xlab = paste0(colnames(gen_dat)[index1], ", (", index1, ")"),
ylab = paste0(colnames(gen_dat)[index2], ", (", index2, ")"),
main = paste(paste0("Pearson of ", round(cor_pearson_mat[index1, index2], 3)),
"\n",
paste0("XI of ", round(cor_XI_mat[index1, index2], 3))))
}
cor_contrast11 <- (abs(cor_spearman_mat) < 0.3) & (abs(cor_dist_mat) > 0.7)
cor_contrast_ind11 <- which(cor_contrast11, arr.ind = T)
nrow(cor_contrast_ind11)
## [1] 9
par(mfrow = c(2, 5))
for (i in 1:nrow(cor_contrast_ind11)){
index1 <- cor_contrast_ind11[i, 1]; index2 <- cor_contrast_ind11[i, 2]
plot(gen_dat[,index1], gen_dat[,index2], col = gen_label, asp = T,
pch = 16, xlab = paste0(colnames(gen_dat)[index1], ", (", index1, ")"),
ylab = paste0(colnames(gen_dat)[index2], ", (", index2, ")"),
main = paste(paste0("Spearman of ", round(cor_spearman_mat[index1, index2], 3)),
"\n",
paste0("Dist. Cor of ", round(cor_dist_mat[index1, index2], 3))))
}
cor_contrast12 <- (abs(cor_spearman_mat) > 0.5) & (abs(cor_dist_mat) < 0.4)
cor_contrast_ind12 <- which(cor_contrast12, arr.ind = T)
nrow(cor_contrast_ind12)
## [1] 2
par(mfrow = c(1, 2))
for (i in 1:nrow(cor_contrast_ind12)){
index1 <- cor_contrast_ind12[i, 1]; index2 <- cor_contrast_ind12[i, 2]
plot(gen_dat[,index1], gen_dat[,index2], col = gen_label, asp = T,
pch = 16, xlab = paste0(colnames(gen_dat)[index1], ", (", index1, ")"),
ylab = paste0(colnames(gen_dat)[index2], ", (", index2, ")"),
main = paste(paste0("Spearman of ", round(cor_spearman_mat[index1, index2], 3)),
"\n",
paste0("Dist. Cor of ", round(cor_dist_mat[index1, index2], 3))))
}
cor_contrast13 <- (abs(cor_kendall_mat) < 0.3) & (abs(cor_dist_mat) > 0.7)
cor_contrast_ind13 <- which(cor_contrast13, arr.ind = T)
nrow(cor_contrast_ind13)
## [1] 9
par(mfrow = c(2, 5))
for (i in 1:nrow(cor_contrast_ind13)){
index1 <- cor_contrast_ind13[i, 1]; index2 <- cor_contrast_ind13[i, 2]
plot(gen_dat[,index1], gen_dat[,index2], col = gen_label, asp = T,
pch = 16, xlab = paste0(colnames(gen_dat)[index1], ", (", index1, ")"),
ylab = paste0(colnames(gen_dat)[index2], ", (", index2, ")"),
main = paste(paste0("Kendall of ", round(cor_kendall_mat[index1, index2], 3)),
"\n",
paste0("Dist. Cor of ", round(cor_dist_mat[index1, index2], 3))))
}
cor_contrast14 <- (abs(cor_kendall_mat) > 0.5) & (abs(cor_dist_mat) < 0.5)
cor_contrast_ind14 <- which(cor_contrast14, arr.ind = T)
nrow(cor_contrast_ind14)
## [1] 0
cor_contrast15 <- (abs(cor_dist_mat) < 0.5) & (abs(cor_hoeffd_mat) > 0.5)
cor_contrast_ind15 <- which(cor_contrast15, arr.ind = T)
nrow(cor_contrast_ind15)
## [1] 0
cor_contrast16 <- (abs(cor_dist_mat) > 0.8) & (abs(cor_hoeffd_mat) < 0.2)
cor_contrast_ind16 <- which(cor_contrast16, arr.ind = T)
nrow(cor_contrast_ind16)
## [1] 10
par(mfrow = c(2, 4))
for (i in 1:nrow(cor_contrast_ind16)){
index1 <- cor_contrast_ind16[i, 1]; index2 <- cor_contrast_ind16[i, 2]
plot(gen_dat[,index1], gen_dat[,index2], col = gen_label, asp = T,
pch = 16, xlab = paste0(colnames(gen_dat)[index1], ", (", index1, ")"),
ylab = paste0(colnames(gen_dat)[index2], ", (", index2, ")"),
main = paste(paste0("Dist. Cor of ", round(cor_dist_mat[index1, index2], 3)),
"\n",
paste0("Hoeffiding's D of ", round(cor_hoeffd_mat[index1, index2], 3))))
}
cor_contrast17 <- (abs(cor_dist_mat) < 0.5) & (abs(cor_XI_mat) > 0.5)
cor_contrast_ind17 <- which(cor_contrast17, arr.ind = T)
nrow(cor_contrast_ind17)
## [1] 0
cor_contrast18 <- (abs(cor_dist_mat) > 0.8) & (abs(cor_XI_mat) < 0.3)
cor_contrast_ind18 <- which(cor_contrast18, arr.ind = T)
nrow(cor_contrast_ind18)
## [1] 10
par(mfrow = c(2, 4))
for (i in 1:nrow(cor_contrast_ind18)){
index1 <- cor_contrast_ind18[i, 1]; index2 <- cor_contrast_ind18[i, 2]
plot(gen_dat[,index1], gen_dat[,index2], col = gen_label, asp = T,
pch = 16, xlab = paste0(colnames(gen_dat)[index1], ", (", index1, ")"),
ylab = paste0(colnames(gen_dat)[index2], ", (", index2, ")"),
main = paste(paste0("Dist. Cor of ", round(cor_dist_mat[index1, index2], 3)),
"\n",
paste0("XI of ", round(cor_XI_mat[index1, index2], 3))))
}
cor_contrast19 <- (abs(cor_dist_mat) < 0.5) & (abs(cor_blomqvist_mat) > 0.5)
cor_contrast_ind19 <- which(cor_contrast19, arr.ind = T)
nrow(cor_contrast_ind19)
## [1] 1
par(mfrow = c(1, 1))
for (i in 1:nrow(cor_contrast_ind19)){
index1 <- cor_contrast_ind19[i, 1]; index2 <- cor_contrast_ind19[i, 2]
plot(gen_dat[,index1], gen_dat[,index2], col = gen_label, asp = T,
pch = 16, xlab = paste0(colnames(gen_dat)[index1], ", (", index1, ")"),
ylab = paste0(colnames(gen_dat)[index2], ", (", index2, ")"),
main = paste(paste0("Dist. Cor of ", round(cor_dist_mat[index1, index2], 3)),
"\n",
paste0("Blomqvist's Beta of ", round(cor_blomqvist_mat[index1, index2], 3))))
}
cor_contrast20 <- (abs(cor_dist_mat) > 0.6) & (abs(cor_blomqvist_mat) < 0.4)
cor_contrast_ind20 <- which(cor_contrast20, arr.ind = T)
nrow(cor_contrast_ind20)
## [1] 4
par(mfrow = c(2, 3))
for (i in 1:nrow(cor_contrast_ind20)){
index1 <- cor_contrast_ind20[i, 1]; index2 <- cor_contrast_ind20[i, 2]
plot(gen_dat[,index1], gen_dat[,index2], col = gen_label, asp = T,
pch = 16, xlab = paste0(colnames(gen_dat)[index1], ", (", index1, ")"),
ylab = paste0(colnames(gen_dat)[index2], ", (", index2, ")"),
main = paste(paste0("Dist. Cor of ", round(cor_dist_mat[index1, index2], 3)),
"\n",
paste0("Blomqvist's Beta of ", round(cor_blomqvist_mat[index1, index2], 3))))
}